{-
    Copyright © 2011 - 2021, Ingo Wechsung
 
    All rights reserved.
 
    Redistribution and use in source and binary forms, with or
    without modification, are permitted provided that the following
    conditions are met:

    -   Redistributions of source code must retain the above copyright
        notice, this list of conditions and the following disclaimer.

    -   Redistributions in binary form must reproduce the above
        copyright notice, this list of conditions and the following
        disclaimer in the documentation and/or other materials provided
        with the distribution. 
    
    -   Neither the name of the copyright holder
        nor the names of its contributors may be used to endorse or
        promote products derived from this software without specific
        prior written permission.
 
    *THIS SOFTWARE IS PROVIDED BY THE
    COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
    IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER
    OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
    LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
    USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
    AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
    IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
    THE POSSIBILITY OF SUCH DAMAGE.*
-}

{--
 
    This package provides common list functions for the Frege language.
    
    It contains all functions described in section 9.1 of the 
    _Haskell 2010 Language Report_, 
    except for 'Data.List#lookup' and 'Data.List#!!'. 
    These functions have been moved 
    to @frege.data.List@ (the equivalent of Haskell's @Data.List@).
    
    In addition to the common list functions, three type classes capture common
    properties of types that are like ordinary lists:
    ['ListEmpty'] provides 'null' to test for empty containers and 'empty' to create one.
    ['ListSemigroup'] introduces the '++' operator.
    ['ListMonoid'] is the union of the previous two.
    ['ListView'] provides 'length', and introduces 'uncons', a safe 
    operation to split a list-view into 'head' and 'tail'.
    ['ListSource'] is the type class for types that can be converted to lists ('toList'). 
    There are instances for 'String', 'Maybe', 'Either' and arrays. 
    
    This module is _implementation specific_ insofar as the compiler may
    assume that certain items are defined here in a certain way.
    Changes may thus lead to compiler crashes or java code that 
    will be rejected by the java compiler.
    
    In particular, desugared list comprehensions will reference 'ListSource.toList'.
    
    This package is implicitly imported.
 -}



protected module frege.prelude.PreludeList 
    inline(sum, product, minimum, maximum, replicate, List.toList) where

import frege.prelude.PreludeBase
import frege.prelude.PreludeBase(StringJ)
import frege.control.Semigroupoid (•)

private type List = []

infixr 13 `++`
infix   9 elem notElem 
    
{--
    A class for containers/collections that have an empty value.
    -}
class ListEmpty α where
    --- *true* if and only if the container is 'empty'
    null  :: α β -> Bool
    --- the empty container
    empty :: α β

--- A class for types that support the (++) operator.
class (ListEmpty α, ListSemigroup α)  => ListMonoid  α where
    {--
    'concat' concatenates the subitems of the argument which is a list of list
    or a list of strings.
    
    It is ok if the argument is an infinite list or any of the sublists is infinite.
    In either case, the result will also be infinite.
    -}
    concat :: [α β] -> α β 
    concat xss = foldr (++) empty xss


--- A class for types that support 'concat'
class ListSemigroup α where
    --- concatenate two lists, strings or whatever
    ---  > empty ++ x == x && x ++ empty == x
    (++) :: α β -> α β -> α β


{--
    A class for things we can view as a list

    Such data types are instances of 'ListMonoid' 
    and support 'head', 'tail', 'length' and concatenation ('++')

    This class provides no means to construct a list. 

-}
class (ListEmpty c, ListSource c) =>  ListView c  where
    --- converts a list-view to a list
    --  toList :: c e -> [c] -- definition from ListSource
    toList xs
        | Just (a, b) <- uncons xs = a : toList b
        | otherwise                = []

    --- split the input stream in head and tail
    uncons :: c e -> Maybe (e, c e)

    --- computes the length of the container in a type dependent way
    length :: c e -> Int
    
    --- drop a number of initial elements
    drop :: Int -> c e -> c e
    drop n xs
        | n <= 0    = xs
        | otherwise = case uncons xs of
            Just (_, ys) -> drop (n-1) ys
            Nothing      -> xs
    
    --- take a number of initial elements
    take :: Int -> c e -> c e

    --- The first element of a list-view, or 'undefined' if 'empty'
    head :: c e -> e
    head = maybe (error "Prelude.head: argument is empty") fst . uncons
    
    --- The tail of a list-view, or 'undefined' if 'empty'
    tail :: c e -> c e
    tail = maybe (error "Prelude.tail: argument is empty") snd . uncons

{--
    A class of things we can make a list from
-}
class ListSource  α  where
    --- converts the value to a list
    toList :: α β -> [β]

--  ------------------------
--  Instances for []
--  ------------------------

derive Ord      [a]

--  ------------------------
--  Instances for ListView
--  ------------------------



--- 'String' viewed as list of 'Char's.
--- List functions on 'String's can get quite expensive when the JVM implements @substring@ via copying.
--- Consider 'frege.data.Iterators#StringIterator' for an alternative
instance ListView StringJ where

    -- 'String.length' is defined in the 'StringJ' type

    uncons x 
        | null x = Nothing
        | otherwise = Just (String.polymorphicElemAt x 0, strtail x 1)    
         
    --- @true@ if and only if the length of the string is 0
    null s = length s == 0
    
    --- A polymorphic empty string. 
    --- This is the only string value whose type is not 'String' that must ever exist.
    pure native empty frege.runtime.Runtime.emptyString :: StringJ elem
    
    take n s = strhead s n
    drop n s = strtail s n

instance ListMonoid StringJ
        -- concatenation is defined in 'String.++'   

instance ListMonoid [] where
    --- Concatenation of two lists
    (a:as) ++ bs = a : as ++ bs
    _      ++ bs = bs

instance ListView [] where
    --- Get the length of a list
    length as = len as 0 where
        len (_:as) !acc = len as (acc+1)
        len []     !acc = acc
    
    --- Access head and tail
    uncons []    = Nothing
    uncons (h:t) = Just (h, t)
        
    --- *true* for the empty list, false otherwise
    null [] = true
    null _  = false
    
    --- the empty list
    empty = []
    
    {--
        @take n xs@ returns the starting sequence of _xs_ with at most _n_ elements.
        If _n_ is greater than the 'length' of _xs_, the result is _xs_.
    
        For negative _n_, the result is undefined.
    
        The following property holds for all lists _xs_ and non negative _n_:
        > take n xs ++ drop n xs == xs
        -}
    take 0 _ = []
    take n (x:xs) = x:take (n-1) xs
    take n _ = []
    
    {--
        @drop n xs@ returns what remains from /xs/ after the /n/ leading elements have been dropped.
        If /n/ is greater than the 'length' of /xs/, the result is the empty list.
    
        For negative /n/, the result is undefined.
    
        The following property holds for all lists /xs/ and non negative /n/:
        > take n xs ++ drop n xs == xs
        -}
    drop 0 lst = lst
    drop n (x:xs) = drop (n-1) xs
    drop n _ = []

    --- warning: head may fail
    head (a:_) = a
    head []    = error "head []"
    
    --- warning: tail may fail
    tail (_:as) = as
    tail []     = error "tail []"

--  ------------------------
--  Instances for ListSource
--  ------------------------
instance ListSource [] where
    --- The list itself.
    toList xs = xs

instance ListSource Maybe where
    --- Singleton with element from 'Just' or empty list for 'Nothing' 
    toList (Just a) = [a]
    toList Nothing  = []

instance ListSource (Either α) where
    --- Singleton with element from 'Right' or empty list for 'Left'
    toList (Left _)  = []
    toList (Right a) = [a]


--
--  Conversion between 'String's and lists and String functions that need the above
--

--- Eagerly converts a 'String' to a list.
unpacked :: String -> [Char]
unpacked s = loop (length s - 1) [] where
        loop :: Int -> [Char] -> [Char]
        loop i res
            | i >= 0    = loop (i-1) (s.charAt i : res)
            | otherwise = res

{--
    convert a list of characters to a string
    > packed ['a', 'b', 'c' ] == "abc"
    Not very efficient, may be replaced by a java function that does it with a
    string buffer later.
    -}
-- fast packed moved to PreludeText    
protected packed [] = ""
protected packed cs = fold (++) "" (map ctos cs)

{--
    @strhead s n@ returns the initial portion of s with at most n characters.
    if s.'length' is lower than n, only so much characters are returned.
    -}
strhead s i = substr s 0 (min i s.length)

--
--  Common list functions. Includes what Haskell 2010 has in Data.List
--       

{--
    'and' returns the conjunction of a Boolean list. 
    For the result to be *true*, the list must be finite; *false*,
    however, results from a *false* value at a finite index of a finite or infinite list.
    -}
and (x:xs) = if x then and xs else false
and _      = true

{--
    'or' returns the disjunction of a Boolean list. 
    For the result to be *false*, the list must be finite; *true*,
    however, results from a *true* value at a finite index of a finite or infinite list.
    -}
or (x:xs) = if x then true else or xs
or _      = false    

{--
    @any p xs@ tells if any element of _xs_ has property _p_.
    This is equivalent to 
    > fold (||) false (map p xs)
    except that
    'any' stops at the first element that has property _p_.

    Note that, according to the identity above,  @any p []@ is always @false@.
    -}
any !p (x:xs) = if p x then true else any p xs
any !p [] = false

{--
    @all p xs@ tells if all elements of _xs_ have property _p_.
    This is equivalent to 
    > fold (&&) true (map p xs) 
    except that
    'all' stops at the first element that hasn't property _p_.

    Note that, according to the identity above, @all p []@ is always @true@.
    -}
all !p (x:xs) = if p x then all p xs else false
all !p [] = true



{--
    Map a function over a list and concatenate the list or string results.
    -}
concatMap f as = concat (map f as) -- [ x | xs <- map f as, x <- xs ]    

{--
    @cycle xs@ builds a value that is an infinite repetition of _xs_, which must not be empty.
    -}
cycle :: [α] -> [α]
cycle xs | null xs   = error "Prelude.cycle []"
         | otherwise = xs ++ cycle xs


{--
    @filter p xs@ returns the list of elements _x_ from _xs_ where (_p x_) holds.

    'filter' will not stop to evaluate its argument list until the first/next
    element with the property asked for is found. For example

    > filter (==true) (repeat false)

    will loop forever, whereas

    > filter even [1..] 

    will faithfully deliver the list of positive integers that are divisible by 2,
    one by one.
    -}
filter !p (x:xs) = if p x then x:filter p xs else filter p xs
filter !p []     = []



{--  warning: It is strongly advised to use 'fold' instead - beware of stack overflow!

    'foldl', applied to a binary operator, a starting value (typically the
    left identity of the operator), and a list, reduces the list using
    the binary operator, from left to right:

    > fold f z [x1, x2, ..., xn] = (((z `f` x1) `f` x2) `f` ...) `f` xn

    Because the operator is applied lazily, 'foldl' typically builds up
    large thunks which, when finally evaluated, may overflow the stack space.
    Therefore, the use of 'fold' instead of 'foldl' is strongly suggested.

    This function exists merely for compatibility with Haskell.

-}
foldl f acc (x:xs) = foldl f  (f acc x) xs
foldl f acc []     = acc

{--
    'fold', applied to a binary operator, a starting value (typically the
    left identity of the operator), and a list, reduces the list using
    the binary operator, from left to right:
    > fold f z [x1, x2, ..., xn] = (((z `f` x1) `f` x2) `f` ...) `f` xn
    'fold' runs in constant stack space, but consumes the entire list before
    returning a result, so it must not be applied to infinite lists.

    This function is known as @foldl'@ in Haskell where there is a bias in favour
    of using 'foldr'.

    In the environment of the JVM stack space is precious, hence one should prefer 'fold'
    when one has the choice.

    'fold' is strict in the accumulator, hence in
    every recursion the intermediate result is evaluated, thus preventing build up of
    possibly huge thunks that result in stack overflows on evaluation.
    -}
fold !f !acc (x:xs) = fold f (f acc x) xs
fold !f !acc []     = acc

--- The sum of the numbers in a list, same as ('fold' ('+') 'zero')
sum = fold (+) zero

--- The product of the numbers in a list, same as ('fold' ('*') 'one')
product = fold (*) one

--- The minimal value of a non empty list, same as ('foldl1' 'min') 
minimum = foldl1 min

--- The maximal value of a non empty list, same as ('foldl1' 'max') 
maximum = foldl1 max



{--
    'foldl1' is a variant of 'fold' that has no starting value argument
    and thus must be applied to nonempty lists only.
    -}
foldl1 f (x:xs) = fold f x xs
foldl1 f _      = error "Prelude.foldl1 f []"

{--
    'scanl' is similar to 'fold' but returns a list of successive
    reduced values from the left:
    > scanl f z [x1, x2, ...] = [z, z `f` x1, (z `f` x1) `f` x2, ... ]
    The following property holds for all finite lists _xs_:
    > last (scanl f z xs) == fold f z xs
    In contrast to 'fold', 'scanl' can operate on infinite lists.
     -}
scanl !f !q (x:xs) = q : scanl f (f q x) xs
scanl !f !z []     = [z]

{--
    'scanl1' is similar to 'scanl', but takes the 'head' of the list as
    starting element and is thus only applicable to non-empty lists.
    > scanl1 f [x1, x2, ...] = [x1, x1 `f` x2, (x1 `f` x2) `f` ...]
    -}
scanl1 f (x:xs)  = scanl f x xs
scanl1 f _       = error "Prelude.scanl1 f []"


--- 'scanr' is the right-to-left dual of 'scanl'.
--- Note that
--- > head (scanr f z xs) == foldr f z xs.
scanr :: (α -> β -> β) -> β -> [α] -> [β]
scanr f q0 (x:xs)       =  f x q : qs
                           where qs = scanr f q0 xs
                                 q  = head qs
scanr _ q0 []           =  [q0] 

--- 'scanr1' is a variant of 'scanr' that has no starting value argument.
-- scanr1 :: ListSource b => (a -> a -> a) -> b a -> [a]
scanr1 _ [x]            =  [x]
scanr1 f (x:xs)         =  f x q : qs
                           where qs = scanr1 f xs
                                 q  = head qs 
scanr1 _ []             =  []

{--
    Fold over a list from right to left.
    > foldr f a (x1:x2:x3:[])
    is the same as
    > x1 `f` (x2 `f` (x3 `f` a))
    Note that, if _f_ is strict in the second argument,
    @foldr f@ will need stack space proportional
    to the length of the list.
    But if _f_ is lazy in it's second argument, 'foldr' works on infinite lists.

    If _f_ is commutative, the list finite and laziness not an issue,
    'fold' may be the better choice since it runs with constant stack space.
    Otherwise, if _f_ is not commutative, 'foldrs' will trade time and heap space for
    stack space by 'fold'ing the 'flip'ped _f_ over the 'reverse'd list.
    -}
-- foldr :: ListSource c => (e->a->a) -> a -> c e -> a
foldr !f acc (x:xs) =  x `f` (foldr f acc xs)
foldr !f acc []     = acc

--- 'foldr1' is a variant of 'foldr' that has no starting argument, and thus must be applied to a non-empty list 
foldr1 f (x:xs) = foldr f x xs
foldr1 f _      = error "Prelude.foldr1 f []"    

{--
    This function may be used in place of
    > foldr f z xs
    if _f_ is strict in its right operand and _xs_ is a finite list,
    in cases where 'foldr' exceeds the stack size, which is usually quite limited in
    the JVM.

    'foldrs' will need extra CPU cycles and maybe (temporary) heap space for
    'reverse'-ing its list argument, before 'fold'ing the 'flip'ped _f_ over it.

    If _f_ is commutative, you may simply use 'fold' instead.

    The following property holds for all finite lists _xs_:
    > foldr f z xs == foldrs f z xs
    -}
foldrs !f z xs = fold (flip f) z (reverse xs)

--- Returns all but the last element from a list.
--- The following property holds for all non-empty finite lists /xs/:
--- > init xs ++ [last xs] == xs
init [x]    = []
init (x:xs) = x : init xs
init _      = error "Prelude.init: empty list"


--- Returns the last element of a list by taking the 'head' of the 'reverse'd list.
--- See also 'init'
last = head • reverse


{--
    @map f xs@ applies _f_ to each element of _xs_ and builds a new list from the results.

    Usage of 'map' is safe on infinite lists, it delivers the result list one by
    one as it is demanded.
    -}
map f (x:xs) = (f x):map f xs
map f _      = []

{--
    reverses a list
    -}
reverse xs = rev xs [] where
    rev (x:xs) ys = rev xs (x:ys)
    rev _     ys = ys


{--
    @splitAt n xs@ returns a tuple where first element is _xs_ prefix of length _n_ 
    and the second element is the
    remainder of the list.
-}
splitAt n xs = (take n xs, drop n xs)

--- @chunked n xs@ makes a list of chunks of _xs_ with size _n_
--- _n_ must be positive, otherwise an infinite list of @[]@ is returned.
--- The following should hold:
--- > n > 0 ==> concat (chunked n xs) == xs
chunked !n [] = []
chunked !n xs = take n xs : chunked n (drop n xs)


{--
    @takeWhile p xs@ takes leading elements from /xs/ while they satisfy the predicate /p/.

    Example:
    > takeWhile (<7) [1,2,3,9,4] == [1,2,3]
    -}
takeWhile !p (x:xs) = if p x then x:takeWhile p xs else []
takeWhile !p _      = []

{--
    @dropWhile p xs@ drops leading elements from _xs_ that satisfy the predicate _p_.

    The following holds for all lists _xs_
    > takeWhile p xs ++ dropWhile p xs == xs
    -}
dropWhile !p (list@(x:xs)) = if p x then dropWhile p xs else list
dropWhile !p _             = []
    

{--
    @span p xs@ returns a tuple whose first element is the longest prefix of _xs_
    elements that satisfy _p_ and whose second element is the remainder of the list.

    > span p xs == (takeWhile p xs, dropWhile p xs)
    -}
span !p xs = (takeWhile p xs, dropWhile p xs)

{--
    'break', applied to a predicate /p/ and a list /xs/, 
    returns a tuple where the first element is the longest prefix
    (possibly empty) of /xs/ elements that do *not* satisfy /p/ 
    and the second element is the remainder of the list.

    @break p@ is equivalent to @span (not • p)@.
-}
break p = span (not • p)

{--
    @e `elem` xs@ is true if and only if at least one of the elements of _xs_ equals _e_.
    -}
-- elem e (h:t) = e == h || elem e t   -- stack overflow!
elem !e (h:t)
    | e == h    = true
    | otherwise = elem e t
elem !e _       = false

--- opposite of 'elem'
notElem !e es = not ( elem e es )


{--
    @repeat a@ builds an infinite list where all elements are _a_.
    -}
repeat a = node where node = a:node

-- @replicate n x@ is a list of length _n_ with _x_ the value of every element.
replicate n = take n • repeat


{--
    @iterate f a@ builds the infinite list @[a, f a, f (f a), ...]@
    -}
iterate !f !a = a:iterate f (f a)



{--
    @zip as bs@ builds a list of tuples of corresponding elements of /as/ and /bs/.
    Trailing elements of the longer list are ignored.
    > zip (1,2,3) "ab" = [(1, "a"), (2, "b")]
    -}
zip (x:xs) (y:ys) = (x,y):zip xs ys
zip _ _  = []

{--
    'unzip' turns a list of tuples into a tuple of lists.
    It is the opposite of 'zip' and the following holds for genuine lists
    > (curry zip @ unzip) xs == xs
    But note that
    > (unzip @ curry zip) (as, bs) == (as,bs)
    will only hold if @length as == length bs@
    -}
unzip    =  foldr (\(a,b) \(as,bs) -> (a:as,b:bs)) ([],[])


{--
    @zipWith f xs ys@ zips two lists with function _f_ instead of the standard '(,)' that
    is used by 'zip'
    -}
zipWith !f (x:xs) (y:ys) = f x y:zipWith f xs ys
zipWith !f _ _ = []

--- 'zip3' zips 3 lists in the same way as 'zip' does it.
zip3 (a:as) (b:bs) (c:cs) = (a,b,c):zip3 as bs cs
zip3 _ _ _ = []

--- 'unzip3' unzips a list of triples and returns a triple of lists.
unzip3    =  foldr (\(a,b,c) \(as,bs,cs) -> (a:as,b:bs,c:cs)) ([],[],[])

--- 'zipWith3' _f_ zips 3 lists with function _f_ instead of the standard '(,,)' that is used by 'zip3'
zipWith3 !f (a:as) (b:bs) (c:cs) = f a b c:zipWith3 f as bs cs
zipWith3 !f _ _ _ = []

{--
    @intersperse a xs@ inserts _a_ between every two elements of _xs_
    > intersperse 0 (1..3) == [1,0,2,0,3]
    -}
protected intersperse a [x]      = [x]
protected intersperse a (x:ys)   = x:a:intersperse a ys
protected intersperse a []       = []


{--
    @xs !! n@ is the element with index _n_ of the list _xs_,
    where the head element of a list has index 0.
-}
(x:_)  !! 0         = x
(_:xs) !! n | n > 0 = xs !! (n-1)
(_:_)  !! n         = error ("Data.List.!!: negative index ("     ++ String.intToString n ++ ")")
[]     !! n         = error ("Data.List.!!: empty list indexed (" ++ String.intToString n ++ ")")
infixl 16 `!!`

